Next: TotalTid := TotalTid+Tid; Tid := 0; CF := Func(PC); CA := Adrs(PC); CC := Corr(PC); PC := PC+1; FinAddr := CA;
if CC <> 0 then FinAddr := FinAddr+C; if CF < 0 or CF > 42 then begin OutText("Ulovlig instruksjonskode: "); OutNum(CF); OutImage; goto StopRun;
end; goto Instr(CF+1); STOP: Tid := 1; goto StopRun; LDI: I := IStore(FinAddr); Tid := 2; goto Next;
STI: IStore(FinAddr) := I; Tid := 2; goto Next; LDC: C := IStore(FinAddr); Tid := 2; goto Next; STC: IStore(FinAddr) := C; Tid := 2; goto Next; ADDI: I := I + IStore(FinAddr); Tid := 2; goto Next;
SUBI: I := I - IStore(FinAddr); Tid := 2; goto Next; MULI: I := I * IStore(FinAddr); Tid := 10; goto Next; DIVI: if IStore(FinAddr) = 0 then begin OutImage;
OutText("Integer division by zero."); OutImage; goto StopRun; end; I := I // IStore(FinAddr); Tid := 15; goto Next;
INI: OutText("Integer value> "); BreakOutImage; InImage; I := InInt; Tid := 100; goto Next; OUTI: OutInt(I, FinAddr); Tid := 50; goto Next; OLIN: OutImage; Tid := 50; goto Next;
JMP: PC := FinAddr; Tid := 1; goto Next; JRC: C := PC; PC := FinAddr; Tid := 1; goto Next; JLTI: if I < 0 then PC := FinAddr; Tid := 1; goto Next; JLEI: if I <= 0 then PC := FinAddr; Tid := 1; goto Next;
JEQI: if I = 0 then PC := FinAddr; Tid := 1; goto Next; JNEI: if I <> 0 then PC := FinAddr; Tid := 1; goto Next; JGTI: if I > 0 then PC := FinAddr; Tid := 1; goto Next; JGEI: if I >= 0 then PC := FinAddr; Tid := 1; goto Next;
SETI: I := FinAddr; Tid := 1; goto Next; INCI: I := I + FinAddr; Tid := 1; goto Next; SETC: C := FinAddr; Tid := 1; goto Next; INCC: C := C + FinAddr; Tid := 1; goto Next;
CIC: C := I; Tid := 1; goto Next; CCI: I := C; Tid := 1; goto Next; LDR: R := RStore(FinAddr); Tid := 10; goto Next; STR: RStore(FinAddr) := R; Tid := 10; goto Next;
ADDR: R := R + RStore(FinAddr); Tid := 10; goto Next; SUBR: R := R - RStore(FinAddr); Tid := 10; goto Next; MULR: R := R * RStore(FinAddr); Tid := 15; goto Next; DIVR: if Rstore(FinAddr) = 0 then begin
OutImage; OutText("Real division by zero."); OutImage; goto StopRun; end;
R := R / RStore(FinAddr); Tid := 20; goto Next; INR: OutText("Real value> "); BreakOutImage; InImage; R := InReal; Tid := 150; goto Next; OUTR: OutFix(R, I, FinAddr); Tid := 100; goto Next;
JLTR: if R < 0 then PC := FinAddr; Tid := 10; goto Next; JLER: if R <= 0 then PC := FinAddr; Tid := 10; goto Next; JEQR: if R = 0 then PC := FinAddr; Tid := 10; goto Next; JNER: if R <> 0 then PC := FinAddr; Tid := 10; goto Next;
JGER: if R >= 0 then PC := FinAddr; Tid := 10; goto Next; JGTR: if R > 0 then PC := FinAddr; Tid := 10; goto Next; ZROR: R := 0; Tid := 1; goto Next; CIR: R := I; Tid := 20; goto Next;
CRI: I := R; Tid := 20; goto Next; StopRun: TotalTid := TotalTid+Tid; if CF<>0 or FinAddr<>0 then DumpRegs; end Run;
PC := 0; I := 0; C := 0; TotalTid := 0; end Flink; ref(Flink) FM;
end Feil4; ref(TegnGenerator) Tgen; character NT; class TegnGenerator;
hidden protected F, LinjeNr, NesteNT, NyttTegn; begin text F; integer LinjeNr;
character NesteNT; procedure SkrivLinjen(UtF); ref(OutFile) UtF; begin
end SkrivLinjen; procedure LukkFil; begin comment Lukk filen F. ;
end LukkFil; procedure NyttTegn(C); character C; begin
comment Et nytt tegn er klar til } sendes videre til Sgen. --"-- Unng} } sende flere blanke etter hverandre. --"-- Gi testutskrift (om |nsket) og send tegnet. ; if NT=' ' and C=' ' then begin
comment Unng} } sende lange sekvenser av blanke. Denne blanke b|r --"-- derfor bare ignoreres. ; end else begin if TTestUtskrift then begin
inspect ListeFil do begin SetPos(TestMarg1); OutText("---T '"); OutChar(C); OutText("' (Rank="); OutInt(Rank(C),3); OutText(")"); OutImage; end inspect;
end if; NT := C; Detach; end if; end NyttTegn;
F:-"prog " & " " & " var sil(40); " & " var i,k; " &
" " & " var stor; " & " " & " " &
" proc fjern in m; " & " var i; " & " begproc " & " i := 2*m; " &
" while i<=40 do " & " sil(i) := 0; " & " i := i+m; " & " endwhile; " &
" endproc; " & " " & "begprog " & " " &
" " & " stor := 1000000; " & " " & " i := 0; " &
" while i<=40 do " & " sil(i) := 1; " & " i := i+1; " & " endwhile; " &
" " & " " & " k := 2; " & " while k<7 do " &
" call fjern with k; " & " k := k+1; " & " endwhile; " & " " &
" " & " if sil(2)<>1 then i := sil(stor); endif; " & " if sil(3)<>1 then i := sil(stor); endif; " & " if sil(5)=/=1 then i := sil(stor); endif; " &
" if sil(7)=/=1 then i := sil(stor); endif; " & " if sil(11)=/=1 then i := sil(stor); endif; " & " if sil(13)=/=1 then i := sil(stor); endif; " & " if sil(17)=/=1 then i := sil(stor); endif; " &
" if sil(19)=/=1 then i := sil(stor); endif; " & " if sil(23)=/=1 then i := sil(stor); endif; " & " if sil(29)=/=1 then i := sil(stor); endif; " & " if sil(31)=/=1 then i := sil(stor); endif; " &
" if sil(37)=/=1 then i := sil(stor); endif; " & " " & " if sil(9)=0 then " & " else i := sil(stor); endif; " &
" if sil(25)=0 then " & " else i := sil(stor); endif; " & " " & " i := 2; " &
" while i<41 do " & " if sil(i)=1 then outint(4)i; endif; " & " i := i+1; " & " endwhile; " &
" " & "endprog; "; Detach; while F.More do begin
NesteNT := F.GetChar; if NesteNT = '-' and F.More then begin NesteNT := F.GetChar; NyttTegn('-'); NyttTegn(NesteNT);
end else begin NyttTegn(NesteNT); end if; end while;
Feil1("Slutten av programmet mangler"); end TegnGenerator; Link class Navn(Id, Nr); value Id;
text Id; integer Nr; begin end Navn;
ref(Head) NavneTab; integer procedure TallAvNavn(T); text T; begin
while NP=/=none and not Funnet do begin if NP.Id = T then Funnet := true else NP :- NP.Suc; end while;
if Funnet then begin TallAvNavn := NP.Nr; end else begin TallAvNavn := NyttNr := NavneTab.Cardinal+1;
new Navn(T,NyttNr).Into(NavneTab); if NTestUtskrift then begin inspect ListeFil do begin SetPos(TestMarg1); OutText("---N Nytt navn (nr."); OutInt(NyttNr,4);
OutText("): "); OutText(T); OutImage; end inspect; end if; end inspect;
end TallAvNavn; text procedure NavnAvTall(N); integer N; begin
ref(Navn) NP; boolean Funnet; NP :- NavneTab.First; while NP=/=none and not Funnet do begin
if NP.Nr = N then Funnet := true else NP :- NP.Suc; end while; NavnAvTall :- Copy(if NP == none then "???" else NP.Id);
end NavnAvTall; boolean procedure ErNokkelord(N); integer N; begin
ErNokkelord := N <= Hwith; end ErNokkelord; Link class Deklarasjon(Navn, Adresse); integer Navn, Adresse;
begin end Deklarasjon; Deklarasjon class VarDeklarasjon;; Deklarasjon class VektorDeklarasjon;;
Deklarasjon class ProsedyreDeklarasjon; begin boolean HarInnParam, HarUtparam; end ProsedyreDeklarasjon;
integer Id; begin comment Let i angitt deklarasjons-liste etter Id. ; ref(Deklarasjon) D;
boolean Funnet; D :- Liste.First; while D=/=none and not Funnet do begin if D.Navn = Id then Funnet := true
else D :- D.Suc; end while; LetIDeklListe :- D; end LetIDeklListe;
procedure NyDeklarasjon(D); ref(Deklarasjon) D; begin comment Sett en ny deklarasjon inn i tabellen i riktig liste. ;
ref(Head) Liste; Liste :- if ErIProsedyre then LokalDeklListe else GlobalDeklListe; if LetIDeklListe(Liste,D.Navn) =/= none then Feil2(NavnAvTall(D.Navn), " er allerede deklarert");
D.Into(Liste); end NyDeklarasjon; ref(Deklarasjon) procedure FinnDeklarasjon(Id); integer Id;
begin ref(Deklarasjon) Dekl; if ErIProsedyre then Dekl :- LetIDeklListe(LokalDeklListe, Id); if Dekl == none then Dekl :- LetIDeklListe(GlobalDeklListe, Id);
if Dekl == none then Feil2(NavnAvTall(Id), " er ikke deklarert"); FinnDeklarasjon :- Dekl; end FinnDeklarasjon; procedure InnIProsedyre;
begin if ErIProsedyre then Feil1("Det er ulovlig } deklarere en prosedyre inne i en annen"); ErIProsedyre := true;
end InnIProsedyre; procedure UtAvProsedyre; begin LokalDeklListe.Clear; ErIProsedyre := false;
Bstorre, Bstorrelik; class SymbolGenerator; hidden protected DetteSy, NyttSy; begin
text DetteSy; procedure NyttSy(H, B, Sy); text Sy; integer H, B;
begin comment Et nytt symbol er klart. Lag test-utskrift (om |nsket), --"-- og send symbolet videre til Fgen. ; if STestUtskrift then begin
inspect ListeFil do begin SetPos(TestMarg1); OutText("---S "); OutInt(H,3); OutInt(B,11); SetPos(Pos+2); OutText(Sy); OutImage; end inspect;
end if; HS := H; BS := B; Detach; end NyttSy; procedure LesNavn;
begin comment Leser et navn (som ogs} kan v{re et reservert ord). ; text Id; integer IdNum;
Id :- Blanks(80); while Letter(NT) or Digit(NT) do begin Id.PutChar(NT); Call(Tgen); end while;
Id :- UpCase(Id.Strip); IdNum := TallAvNavn(Id); if ErNokkelord(IdNum) then NyttSy(IdNum,0,Id) else NyttSy(Hnavn,IdNum,Id);
end LesNavn; procedure LesKonstant; begin comment Leser en numerisk konstant. ;
text Buf; Buf :- Blanks(9); while Digit(NT) do begin if not Buf.More then
Feil3("Numerisk konstant `", Buf, "..' er for stor"); Buf.PutChar(NT); Call(Tgen); end while; NyttSy(Hkonst,Buf.GetInt,Buf);
end LesKontant; Detach; Call(Tgen); while true do begin
while NT = ' ' do Call(Tgen); if Letter(NT) then LesNavn else if Digit(NT) then LesKonstant else if NT = '+' then begin NyttSy(Haritop,Bpluss,"+"); Call(Tgen) end else
if NT = '-' then begin NyttSy(Haritop,Bminus,"-"); Call(Tgen) end else if NT = '*' then begin NyttSy(Haritop,Bganger,"*"); Call(Tgen) end else if NT = '/' then begin NyttSy(Haritop,Bdivisjon,"/"); Call(Tgen) end else if NT = '(' then begin NyttSy(Hvenstrepar,0,"("); Call(Tgen) end else
if NT = ')' then begin NyttSy(Hhoyrepar,0,")"); Call(Tgen) end else if NT = ',' then begin NyttSy(Hkomma,0,","); Call(Tgen) end else if NT = ';' then begin NyttSy(Hsemikolon,0,";"); Call(Tgen) end else if NT = '<' then begin
Call(Tgen); if NT = '=' then begin NyttSy(Hsammenlign,Bmindrelik,"<="); Call(Tgen); end else
if NT = '>' then begin NyttSy(Hsammenlign,Bulik,"<>"); Call(Tgen); end else NyttSy(Hsammenlign,Bmindre,"<"); end else
if NT = '=' then begin Call(Tgen); if NT = '/' then begin Call(Tgen);
if NT = '=' then begin NyttSy(Hsammenlign,Bulik,"<>"); Call(Tgen); end else Feil3("Ulovlig tegn-kombinasjon: `=/", TextAvChar(NT), "'"); end else NyttSy(Hsammenlign,Blik,"=");
end else if NT = '>' then begin Call(Tgen); if NT = '=' then begin
NyttSy(Hsammenlign,Bstorrelik,">="); Call(Tgen); end else NyttSy(Hsammenlign,Bstorre,">"); end else if NT = ':' then begin
Call(Tgen); if NT = '=' then begin NyttSy(Htilordn,0,":="); Call(Tgen); end else Feil3("Ulovlig tegn-kombinasjon: `:", TextAvChar(NT), "'");
end else Feil3("Ulovlig tegn: `", TextAvChar(NT), "'"); end while; end SymbolGenerator; class VarInfo(Adresse);
integer Adresse; begin comment Klasse (brukt av Fgen) for } lagre informasjon om en variabel- --"-- forekomst i Minila-programmet. Foruten variabelens Adresse
--"-- lagres f|lgende opplysninger: --"-- Indeksert: `true' hvis variabelen var indeksert (f.eks. `A(I)'), --"-- `false' hvis kun en vanlig variabel (f.eks. `B'). --"-- VarIndeks: `true' hvis indeksen var en variabel (som i `A(I)'),
--"-- `false' hvis indeksen var en konstant (som i `A(5)'). --"-- IndeksAdr: Indeks-variabelens adresse --"-- (kun aktuelt hvis Indeksert & VarIndeks). --"-- IndeksVerdi: Indeks-konstantens verdi
--"-- (kun aktuelt hvis Indeksert & not Varindeks). ; integer IndeksAdr, IndeksVerdi; boolean Indeksert, VarIndeks; end VarInfo;
ref(FlinkGenerator) Fgen; class FlinkGenerator; hidden protected Synlig; begin
boolean Synlig; text array InstrNavn(0:25); integer array AritOpKode(1:4), BetOpKode(1:6);
procedure TestProc1(ProcId); text ProcId; begin comment Programmet er g}tt inn i en ny analyse-prosedyre.
--"-- Gi en passende testutskrift. ; integer I; inspect ListeFil do begin SetPos(TestMarg1); OutText("---R ");
for I := 1 step 1 until ProcNivaa do OutText(" "); OutText("Start "); OutText(ProcId); OutImage; end inspect; ProcNivaa := ProcNivaa+1;
end TestProc1; procedure TestProc2(ProcId); text ProcId; begin
comment Programmet er g}tt ut av en analyse-prosedyre. --"-- Gi en passende testutskrift. ; integer I; ProcNivaa := ProcNivaa-1;
inspect ListeFil do begin SetPos(TestMarg1); OutText("---R "); for I := 1 step 1 until ProcNivaa do OutText(" "); OutText("Slutt "); OutText(ProcId); OutImage;
end inspect; end TestProc2; procedure LagInstr(FK, AK, CK); integer FK, AK, CK;
begin comment Genererer en Flink-instruksjon. ; if NesteInstr > FM.MaxInstr then Feil2("Programmet er for langt, ",
"det er ikke nok plass i Flinks's instruksjonslager"); inspect FM do begin Func(NesteInstr) := FK; Adrs(NesteInstr) := AK; Corr(NesteInstr) := CK; end inspect;
if FTestUtskrift then begin inspect ListeFil do begin SetPos(TestMarg2); OutText("---F"); OutInt(NesteInstr,14); OutText(": "); OutText(InstrNavn(FK));
SetPos(TestMarg2+24); OutInt(AK,12); IF CK=1 then OutText(" *"); OutImage; end inspect; end if;
NesteInstr := NesteInstr+1; end LagInstr; procedure LagHentVar(VI); ref(VarInfo) VI;
begin comment Lager kode for } hente variabelen VI inn i I-reg. ; if VI.Indeksert then begin if VI.VarIndeks then LagInstr(Ildc, VI.IndeksAdr, 0)
else LagInstr(Isetc, VI.IndeksVerdi, 0); end if; LagInstr(Ildi, VI.Adresse, if VI.Indeksert then 1 else 0); end LagHentVar;
procedure LagSettVar(VI); ref(VarInfo) VI; begin comment Lager kode for } sette verdien i I-reg ned i variabelen VI. ;
if VI.Indeksert then begin if VI.VarIndeks then LagInstr(Ildc, VI.IndeksAdr, 0) else LagInstr(Isetc, VI.IndeksVerdi, 0); end if;
LagInstr(Isti, VI.Adresse, if VI.Indeksert then 1 else 0); end LagSettVar; procedure FyllGammelAdr(Lok, NyAdr); integer Lok, NyAdr;
begin comment Opdater adresse-delen av den tidligere genererte instruksjonen --"-- i lokasjonen Lok til } v{re NyAdr. ; FM.Adrs(Lok) := NyAdr;
if FTestUtskrift then begin inspect ListeFil do begin SetPos(TestMarg2); OutText("---F"); OutInt(Lok,14); OutText(">>>"); OutInt(NyAdr,15); OutImage;
end inspect; end if; end FyllGammelAdr; integer procedure SettAvKonstant(Verdi);
integer Verdi; begin comment Sett inn en ny konstant i Flink's heltallslager. --"-- Returner den nye konstantens adresse. ;
if NesteInt > FM.MaxIntt then Feil1("Ikke mer plass i Flink's heltallslager"); if FTestUtskrift then begin inspect ListeFil do begin
SetPos(TestMarg2); OutText("---F K"); OutInt(NesteInt,11); OutText(": "); OutInt(Verdi,16); OutImage; end inspect; end if;
begin comment Sett av plass i Flink's heltallslager til en ny vektor. --"-- Returner den nye vektorens start-adresse. ; if NesteInt+AntElem > FM.MaxIntt+1 then
Feil1("Ikke mer plass i Flink's heltallslager"); if FTestUtskrift then begin inspect ListeFil do begin SetPos(TestMarg2); OutText("---F A"); OutInt(NesteInt,5);
OutChar('-'); OutInt(NesteInt+AntElem-1,5); OutText(": "); OutText(NavnAvTall(Id)); OutImage; end inspect; end if;
begin comment Forvent } finne symbolet Sy. Hvis HS <> Sy, --"-- kall feil-prosedyren. ; if HS <> Sy then begin
Feil4("Det skulle kommet ", TextAvSymbol(Sy), " n}, ikke ", TextAvSymbol(HS)); end if; end Forvent;
procedure LesBetingelse(TestAdresse); name TestAdresse; integer TestAdresse; begin
comment Les en betingelse. Adressen til den instruksjonen som hopper --"-- hvis betingelsen var gal (= `false'), returneres i TestAdresse. ; integer BetOp; if RTestUtskrift then TestProc1("Betingelse");
TestAdresse := NesteInstr; LagInstr(BetOpKode(BetOp), -1, 0); if RTestUtskrift then TestProc2("Betingelse"); end LesBetingelse; procedure LesCallSetning;
begin ref(VarInfo) VIP; if RTestUtskrift then TestProc1("CallSetning"); Call(Sgen); Forvent(Hnavn);
inspect FinnDeklarasjon(BS) when ProsedyreDeklarasjon do begin Call(Sgen); if HarInnParam then begin Forvent(Hwith); Call(Sgen); LesUttrykk;
end if; LagInstr(Ijrc, Adresse, 0); if HarUtParam then begin Forvent(Hinto); Call(Sgen); LagSettVar(LesVariabel);
end if; end otherwise Feil2(NavnAvTall(BS), " er ikke en prosedyre"); if RTestUtskrift then TestProc2("CallSetning"); end LesCallSetning;
procedure LesDeklListe(Termin); integer Termin; begin comment Les en liste av deklarasjoner terminert av symbolet Termin. ;
if RTestUtskrift then TestProc1("DeklListe"); while HS <> Termin do begin if HS = Hvar then LesVarDekl else if HS = Hproc then LesProcDekl else
Feil2("En deklarasjon m} starte med VAR eller PROC, ikke ", TextAvSymbol(HS)); Forvent(Hsemikolon); Call(Sgen); end while;
if RTestUtskrift then TestProc2("DeklListe"); end LesDeklListe; procedure LesIfSetning; begin
integer TestAdresse, ElseAdresse; if RTestUtskrift then TestProc1("IfSetning"); Call(Sgen); LesBetingelse(TestAdresse); Forvent(Hthen); Call(Sgen); LesSetnListe(Helse, Hendif);
if HS = Helse then begin ElseAdresse := NesteInstr; LagInstr(Ijmp, -1, 0); FyllGammelAdr(TestAdresse, NesteInstr); Call(Sgen); LesSetnListe(Hendif, -1);
FyllGammelAdr(ElseAdresse, NesteInstr); end else begin FyllGammelAdr(TestAdresse, NesteInstr); end if;
Call(Sgen); if RTestUtskrift then TestProc2("IfSetning"); end LesIfSetning; procedure LesOutintSetning;
begin integer Bredde; if RTestUtskrift then TestProc1("OutintSetning"); Call(Sgen); Forvent(Hvenstrepar);
Call(Sgen); Forvent(Hkonst); Bredde := BS; Call(Sgen); Forvent(Hhoyrepar); Call(Sgen); LesUttrykk; LagInstr(Iouti, Bredde, 0); if RTestUtskrift then TestProc2("OutintSetning");
end LesOutintSetning; procedure LesOutlineSetning; begin if RTestUtskrift then TestProc1("OutlineSetning");
LagInstr(Iolin, 0, 0); Call(Sgen); if RTestUtskrift then TestProc2("OutlineSetning"); end LesOutlineSetning; procedure LesProcDekl;
begin ref(ProsedyreDeklarasjon) PD; integer PDnavn; integer InnParamAdr, UtParamAdr, ReturAdrAdr;
if RTestUtskrift then TestProc1("ProcDekl"); Call(Sgen); Forvent(Hnavn); PDnavn:=bs; PD :- new ProsedyreDeklarasjon(PDnavn, NesteInstr); NyDeklarasjon(PD); ReturAdrAdr := SettAvVariabel(PDnavn);
InnIProsedyre; Call(Sgen); if HS<>Hin and HS<>Hout and HS<>Hsemikolon then Feil2("Her kan det st} IN, OUT eller `;', ikke ", TextAvSymbol(HS));
if HS = Hin then begin Call(Sgen); Forvent(Hnavn); PD.HarInnParam := true; InnParamAdr := SettAvVariabel(BS); NyDeklarasjon(new VarDeklarasjon(BS,InnParamAdr));
Call(Sgen); end if; if HS<>Hout and HS<>Hsemikolon then Feil2("Her kan det st} OUT eller `;', ikke ", TextAvSymbol(HS));
if HS = Hout then begin Call(Sgen); Forvent(Hnavn); PD.HarUtParam := true; UtParamAdr := SettAvVariabel(BS); NyDeklarasjon(new VarDeklarasjon(BS,UtParamAdr));
Call(Sgen); end if; LagInstr(Istc, ReturAdrAdr, 0); if PD.HarInnParam then LagInstr(Isti, InnParamAdr, 0);
Forvent(Hsemikolon); Call(Sgen); LesDeklListe(Hbegproc); Call(Sgen); LesSetnListe(Hendproc,-1); Call(Sgen); if PD.HarUtParam then LagInstr(Ildi, UtParamAdr, 0); LagInstr(Ildc, ReturAdrAdr, 0);
LagInstr(Ijmp, 0, 1); UtAvProsedyre; if RTestUtskrift then TestProc2("ProcDekl"); end LesProcDekl;
procedure LesProgram; begin if RTestUtskrift then TestProc1("Program"); LagInstr(Ijmp, -1, 0);
if RTestUtskrift then TestProc2("Program"); end LesProgram; procedure LesSetnListe(Termin1, Termin2); integer Termin1, Termin2;
begin comment Les en setningsliste som avsluttes av ett av de to terminator- --"-- symbolene Termin1 eller Termin2. (Hvis listen kun har ett --"-- terminator-symbol, kan den andre parameteren settes til -1.) ;
if RTestUtskrift then TestProc1("SetnListe"); while HS<>Termin1 and HS<>Termin2 do begin if HS = Hcall then LesCallSetning else if HS = Hif then LesIfSetning else
if HS = Houtint then LesOutintSetning else if HS = Houtline then LesOutlineSetning else if HS = Hwhile then LesWhileSetning else if HS = Hnavn then LesTilordning else
Feil2("En setning kan ikke starte med ", TextAvSymbol(HS)); Forvent(Hsemikolon); Call(Sgen); end while; if RTestUtskrift then TestProc2("SetnListe");
end LesSetnListe; procedure LesTilordning; begin ref(VarInfo) VenstreSide;
if RTestUtskrift then TestProc1("Tilordning"); VenstreSide :- LesVariabel; Forvent(Htilordn); Call(Sgen); LesUttrykk; LagSettVar(VenstreSide); if RTestUtskrift then TestProc2("Tilordning");
end LesTilordning; procedure LesUttrykk; begin procedure LesOperand1;
begin comment Leser f|rste (og muligens eneste) operand i et uttrykk. ; if HS = Hnavn then begin LagHentVar(LesVariabel);
end else if HS = Hkonst then begin LagInstr(Iseti, BS, 0); Call(Sgen); end else
if HS = Hinint then begin LagInstr(Iini, 0, 0); Call(Sgen); end else Feil2(TextAvSymbol(HS), " kan ikke brukes som operand i uttrykk");
end LesOperand1; procedure LesOperand2(Opp); integer Opp; begin
comment Leser andre operand til operatoren Op. ; ref(VarInfo) VI; if HS = Hnavn then begin VI :- LesVariabel;
if VI.Indeksert then begin if VI.VarIndeks then LagInstr(Ildc, VI.IndeksAdr, 0) else LagInstr(Isetc, VI.IndeksVerdi, 0); end if;
LagInstr(AritOpKode(Opp), VI.Adresse, if VI.Indeksert then 1 else 0); end else if HS = Hkonst then begin LagInstr(AritOpKode(Opp), SettAvKonstant(BS), 0);
Call(Sgen); end else if HS = Hinint then begin LagInstr(Icic, 0, 0); LagInstr(Iini, 0, 0);
Feil2(TextAvSymbol(HS), " kan ikke brukes som operand i uttrykk"); end LesOperand2; integer OpNum; if RTestUtskrift then Testproc1("Uttrykk");
LesOperand1; while HS = Haritop do begin OpNum := BS; Call(Sgen); LesOperand2(OpNum); end while;
if RTestUtskrift then Testproc2("Uttrykk"); end LesUttrykk; procedure LesVarDekl; begin
procedure LesNyVar; begin comment Les en ny variabel i en variabel-deklarasjon. ; integer VarId, MaxElem;
Forvent(Hnavn); VarId := BS; Call(Sgen); if HS = Hvenstrepar then begin Call(Sgen); Forvent(Hkonst); MaxElem := BS; NyDeklarasjon(new VektorDeklarasjon(VarId,
SettAvVektor(MaxElem+1,VarId))); Call(Sgen); Forvent(Hhoyrepar); Call(Sgen); end else begin NyDeklarasjon(new VarDeklarasjon(VarId,SettAvVariabel(VarId)));
end; end LesNyVar; if RTestUtskrift then TestProc1("VarDekl"); Call(Sgen); LesNyVar;
while HS = Hkomma do begin Call(Sgen); LesNyVar; end while; if RTestUtskrift then TestProc2("VarDekl");
end LesVarDekl; ref(VarInfo) procedure LesVariabel; begin comment Leser en <Variabel>, men lager ingen kode. ;
ref(Deklarasjon) VD, ID; ref(VarInfo) VI; if RTestUtskrift then TestProc1("Variabel"); Forvent(Hnavn); VD :- FinnDeklarasjon(BS);
if VD is ProsedyreDeklarasjon then Feil2(NavnAvTall(VD.Navn), " er en prosedyre, ikke en variabel"); LesVariabel :- VI :- new VarInfo(VD.Adresse); Call(Sgen);
if HS = Hvenstrepar then begin if VD is VarDeklarasjon then Feil2(NavnAvTall(VD.Navn), " er en vanlig variabel, og kan ikke indekseres");
VI.Indeksert := true; Call(Sgen); if HS = Hnavn then begin ID :- FinnDeklarasjon(BS); if not(ID is VarDeklarasjon) then
Feil2("En indeks m} v{re en vanlig variabel; det er ikke ", NavnAvTall(ID.Navn)); VI.VarIndeks := true; VI.IndeksAdr := ID.Adresse; end else
if HS = Hkonst then begin VI.IndeksVerdi := BS; end else Feil2("En indeks m} v{re et navn eller en konstant, ikke ",
TextAvSymbol(HS)); Call(Sgen); Forvent(Hhoyrepar); Call(Sgen); end else begin if VD is VektorDeklarasjon then
Feil2(NavnAvTall(VD.Navn), " er en vektor, og skulle v{rt indeksert"); end if; if RTestUtskrift then TestProc2("Variabel"); end LesVariabel;
procedure LesWhileSetning; begin integer WhileStart, TestAdresse; if RTestUtskrift then TestProc1("WhileSetning");
Call(Sgen); LesProgram; end FlinkGenerator; text procedure TextAvChar(C); character C;
begin comment Lag en text av lengde 1 som inneholder C. ; text T; TextAvChar :- T :- Blanks(1); T.PutChar(C);
end TextAvChar; text procedure TextAvSymbol(S); integer S; begin
comment Lag en tekstlig representasjon av symbolet S. ; if S=Hnavn then TextAvSymbol :- "et navn" else if S=Hkonst then TextAvSymbol :- "en tall-konstant" else if S=Haritop then TextAvSymbol :- "en aritmetisk operator" else
if S=Hsammenlign then TextAvSymbol :- "en sammenligningsoperator" else if S=Hvenstrepar then TextAvSymbol :- "`('" else if S=Hhoyrepar then TextAvSymbol :- "`)'" else if S=Hkomma then TextAvSymbol :- "`,'" else
if S=Hsemikolon then TextAvSymbol :- "`;'" else if S=Htilordn then TextAvSymbol :- "`:='" else TextAvSymbol :- NavnAvTall(S); end TextAvSymbol;
begin character C; FM :- new Flink(400,400,1); NavneTab :- new Head;